home *** CD-ROM | disk | FTP | other *** search
/ NeXT Education Software Sampler 1992 Fall / NeXT Education Software Sampler 1992 Fall.iso / Programming / Source / winterp-1.13 / contrib / xmu / GNU / xmenu-lib.el < prev    next >
Encoding:
Text File  |  1991-10-06  |  4.6 KB  |  114 lines
  1. ; -*-Emacs-Lisp-*-
  2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3. ;
  4. ; File:         xmenu-lib.el
  5. ; RCS:          $Header: $
  6. ; Description:  Simple interface to xmu-menu.el WINTERP-based menu server.
  7. ; Author:       Richard Hess, Consilium.
  8. ; Created:      Sat Oct  5 23:24:49 1991
  9. ; Modified:     Sat Oct  5 23:42:54 1991 (Niels Mayer) mayer@hplnpm
  10. ; Language:     Emacs-Lisp
  11. ; Package:      N/A
  12. ; Status:       X11r5 contrib tape release
  13. ;
  14. ; WINTERP Copyright 1989, 1990, 1991 Hewlett-Packard Company (by Niels Mayer).
  15. ; XLISP version 2.1, Copyright (c) 1989, by David Betz.
  16. ;
  17. ; Permission to use, copy, modify, distribute, and sell this software and its
  18. ; documentation for any purpose is hereby granted without fee, provided that
  19. ; the above copyright notice appear in all copies and that both that
  20. ; copyright notice and this permission notice appear in supporting
  21. ; documentation, and that the name of Hewlett-Packard and David Betz not be
  22. ; used in advertising or publicity pertaining to distribution of the software
  23. ; without specific, written prior permission.  Hewlett-Packard and David Betz
  24. ; make no representations about the suitability of this software for any
  25. ; purpose. It is provided "as is" without express or implied warranty.
  26. ;
  27. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  28.  
  29. ;; ---------------------------------------------------------------------------
  30. ;; REF:   Derived from work by Mark A. Kolb & Gill Derge... [ gnu.epoch.misc ]
  31. ; +---------------------------------------------------------------------------
  32. ;  WHO:    Richard Hess                    CORP:   Consilium
  33. ;  TITLE:  Staff Engineer                  VOICE:  [415] 691-6342
  34. ;      [ X-SWAT Team:  Special Projects ]  USNAIL: 640 Clyde Court
  35. ;  UUCP:   ...!uunet!cimshop!rhess                 Mountain View, CA 94043
  36. ; +---------------------------------------------------------------------------
  37.  
  38. (require 'xmu-menu)
  39. (provide 'xmenu-lib)
  40.  
  41. (defvar xmenu-max-width 20)
  42.  
  43. ;; ------------------------------------------------------------------[ XMENU ]
  44.  
  45. (defun xmenu (heading choices &optional choice-list)
  46.   "Pops up an XMENU menu to select a string from among CHOICES.
  47. Returns the selected string or NIL if the abort option is selected.
  48. If CHOICE-LIST is provided, then instead of returning a string from
  49. CHOICES, the corresponding item from CHOICE-LIST is returned."
  50.   (let* ()
  51.     (let ((filtered-choices (xmenu-string-items choices))
  52.       (choice-count (length choices))
  53.       (key (user-real-uid))
  54.       )
  55.       (xmu_menu key heading filtered-choices "::GNU [ xmenu ]")
  56.       (let* ((xpick (xmu_popup key t))
  57.          (result-int (string-to-int xpick))
  58.          (result (if (or (equal xpick "")
  59.                  (= result-int choice-count))
  60.              nil
  61.                (nth result-int (or choice-list choices)))))
  62.     result))))
  63.  
  64. ;;;  Auxiliary functions for filtering XMENU choice strings.
  65. ;;;  This munging is necessary because we're passing out arbitrary
  66. ;;;  strings to the shell.  Much of this code is also courtesy Gill Derge.
  67.  
  68. (defun xmenu-string-items (strings)
  69.   "Transform STRINGS into a list of menu choices suitable for XMENU,
  70. tacking on an equals sign and a count onto the end of each transformed string."
  71.   (%xmenu-string-items strings 0))
  72.  
  73. (defun %xmenu-string-items (strings count)
  74.   (if (null strings) nil
  75.     (cons (xmenu-string-item (car strings) count)
  76.       (%xmenu-string-items (cdr strings) (1+ count)))))
  77.  
  78. (defun xmenu-string-item (string count)
  79.   "Transforms STRING into a choice-item for XMENU.
  80. This function will also tack on the the number of the item.
  81. Thus, (xmenu-string-item \"This string\") will yield \"This string=0\"
  82. if COUNT is zero.  Truncation is also performed here--menu items are of
  83. finite width."
  84.   (let ((shortened-string (if (< (length string) xmenu-max-width)
  85.                   string
  86.                 (concat (substring string 0 (- xmenu-max-width 3))
  87.                     "..."))))
  88.     (cons (format "%s"
  89.           (xmenu-quote-regexp
  90.            (xmenu-quote-regexp shortened-string "\\\\") "="))
  91.       (cons (format "%d" count)
  92.         nil))
  93.     ))
  94.  
  95. (defun xmenu-quote-regexp (string regexp)
  96.   "Quote anything in STRING that matches REGEXP with '\'."
  97.   (let ((str-len (length string))
  98.     (work-str string)
  99.     last-match)
  100.     (setq last-match 0)
  101.     (while (< last-match str-len)
  102.       (if (string-match regexp (substring work-str last-match nil))
  103.       (progn (setq last-match (+ last-match (match-end 0)))
  104.          (setq work-str
  105.                (concat
  106.             (substring work-str 0 (- last-match 1)) "\\"
  107.             (substring work-str (- last-match 1) nil)))
  108.          (setq last-match (+ last-match 2))
  109.          (setq str-len (+ str-len 2)))
  110.     (setq last-match str-len)))
  111.     work-str))
  112.  
  113. ;; ----<eof>
  114.